#!/usr/bin/perl

# Copyright 2014 Jan Pazdziora
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

use strict;
use warnings FATAL => 'all';

use IO::File ();
use IO::Dir ();
use IO::Socket::UNIX ();
use Socket ();
use Data::Dumper ();
use POSIX ();

sub log_command {
	local * LOG;
	open(LOG, '>>', '/var/log/systemctl.log');
	print LOG @_;
	close LOG;
}
log_command("[@ARGV]\n");

for (my $i = 0; $i < @ARGV; $i++) {
	if ($ARGV[$i] eq '--ignore-dependencies') {
		splice @ARGV, $i, 1;
		last;
	}
}
if (@ARGV == 1 and $ARGV[0] eq 'daemon-reload') {
	exit 0;
}
if (@ARGV == 2 and $ARGV[0] eq '--system' and $ARGV[1] eq 'daemon-reload') {
	exit 0;
}

for (keys %ENV) {
	delete $ENV{$_};
}

my $BASE_DIR = '/etc/systemctl-lite';
if (not -d $BASE_DIR) {
	mkdir $BASE_DIR;
}
my $RUNNING_DIR = "$BASE_DIR/running";
if (not -d $RUNNING_DIR) {
	mkdir $RUNNING_DIR;
}
my $ENABLED_DIR = "$BASE_DIR/enabled";
if (@ARGV == 1) {
	if ($ARGV[0] eq 'start-enabled' and -d $ENABLED_DIR) {
		local * ENABLED;
		opendir ENABLED, $ENABLED_DIR;
		my %services;
		while (defined(my $f = readdir ENABLED)) {
			next if $f eq '.' or $f eq '..';
			my $modified = (stat "$ENABLED_DIR/$f")[9];
			if (defined $modified) {
				$services{$f} = $modified;
			}
		}
		close ENABLED;
		for my $s (sort { $services{$a} <=> $services{$b} or $a cmp $b } keys %services) {
			print "Starting [$s]\n";
			system $0, 'start', $s;
		}
	}
	if ($ARGV[0] eq 'stop-running' and -d $RUNNING_DIR) {
		local * RUNNING;
		opendir RUNNING, $RUNNING_DIR;
		my %services;
		while (defined(my $f = readdir RUNNING)) {
			next if $f eq '.' or $f eq '..';
			my $modified = (stat "$RUNNING_DIR/$f")[9];
			if (defined $modified) {
				my $trimmed = $f;
				$trimmed =~ s/\..+$//;
				$services{$trimmed} = $modified;
			}
		}
		close RUNNING;
		for my $s (sort { $services{$b} <=> $services{$a} or $a cmp $b } keys %services) {
			system $0, 'stop', $s;
		}
	}
	exit;
}

if (@ARGV != 2) {
	die "Usage: $0 (start|stop|status|...) (service|target|socket thing)\n";
}

my ($COMMAND, $SERVICE) = @ARGV;
my $TYPE = 'service';
if ($SERVICE =~ /\.(target|socket)$/) {
	$TYPE = $1;
} elsif (not $SERVICE =~ /\.service$/) {
	$SERVICE .= '.service';
}

my @PATHS = (
	'/etc/systemd/system',
	'/run/systemd/system',
	'/usr/lib/systemd/system',
);

my $FULL_SERVICE = $SERVICE;
my $INSTANCE = undef;

my $file = undef;
if ($SERVICE =~ s/\@(.+)\.service$/\@.service/) {
	$INSTANCE = $1;
}
for my $p (@PATHS) {
	if (-e "$p/$SERVICE") {
		if (-l "$p/$SERVICE") {
			my $new_service = readlink("$p/$SERVICE");
			log_command("Service [$p/$SERVICE] is a symlink to [$new_service]\n");
			$new_service =~ s!^.*/!!;
			$SERVICE = $new_service;
		}
		$file = "$p/$SERVICE";
		last;
	}
}

if ($SERVICE =~ s/\@(.+)\.service$/\@.service/) {
	$INSTANCE = $1;
	for my $p (@PATHS) {
		if (-f "$p/$SERVICE") {
			$file = "$p/$SERVICE";
			last;
		}
	}
}

if (not defined $file) {
	if ($COMMAND eq 'is-enabled') {
		exit 1;
	}
	if ($COMMAND eq 'is-active') {
		exit 3;
	}
	warn "No service definition found for [$FULL_SERVICE].\n";
	exit 2;
}

sub parse_file {
	my ($file, $data) = @_;
	if (-d $file) {
		my $dh = new IO::Dir($file);
		while (defined(my $de = $dh->read)) {
			next if $de eq '.' or $de eq '..';
			push @{$data->{'Unit.Wanted'}}, $de;
		}
		$dh->close;
		return;
	}
	my $fh = new IO::File($file);
	my $section = 'undefined';
	while (my $line = <$fh>) {
		chomp $line;
		if ($line =~ /^\[(.+)\]\s*$/) {
			$section = $1;
			next;
		}
		next if $line =~ /^\s*(#|$)/;
		if ($line =~ /^\.include\s(.+)/) {
			parse_file($1, $data);
			next;
		}
		my ($key, $value) = split /=/, $line, 2;
		if (defined $INSTANCE) {
			$value =~ s/\%i/$INSTANCE/g;
		}
		if ($key eq 'EnvironmentFile') {
			if ($value eq '') {
				delete $data->{"$section.$key"};
			} else {
				push @{ $data->{"$section.$key"} }, $value;
			}
		} elsif ($key =~ /^(ExecStart(Pre|Post)|ExecReload|ExecStop(Pre|Post)?)$/) {
			push @{ $data->{"$section.$key"} }, $value;
		} else {
			$data->{"$section.$key"} = $value;
		}
	}
	$fh->close;
}

my $data = {};
parse_file($file, $data);
for my $p (@PATHS) {
	if (-d "$p/$SERVICE.wants") {
		$file = "$p/$SERVICE.wants";
		parse_file("$p/$SERVICE.wants", $data);
		last;
	}
}

if ($COMMAND eq 'show') {
	print Data::Dumper::Dumper $data;
	exit;
}

sub killall {
	my ($signal, $command) = @_;
	my $pids = `/usr/sbin/pidof $command`;
	chomp $pids;
	if ($pids eq '') {
		return 0;
	} elsif ($signal == 0) {
		return 1;
	} else {
		return kill $signal, split /\s+/, $pids;
	}
}

sub get_exec_start {
	my $data = shift;
	my $d = $data->{'Service.ExecStart'};
	if (not defined $d) {
		warn "No ExecStart value found for [$SERVICE].\n";
		exit 3;
	}
	return split /\s+/, $d;
}

sub get_pid {
	my $file = shift;
	if (not $file =~ m!^/!) {
		$file = "$RUNNING_DIR/$file";
	}
	if (-f $file) {
		local * PIDFILE;
		open PIDFILE, '<', $file;
		my $pid = <PIDFILE>;
		close PIDFILE;
		if (defined $pid) {
			chomp $pid;
			return $pid;
		}
	}
}

sub is_running {
	my $data = shift;
	my $ret;
	if (-f "$RUNNING_DIR/$FULL_SERVICE.oneshot") {
		return 1;
	} elsif (defined $data->{'Service.PIDFile'}) {
		my $pid = get_pid($data->{'Service.PIDFile'});
		if (defined $pid) {
			$ret = kill 0, $pid;
		}
	} else {
		my $path = get_pid("$FULL_SERVICE.name");
		if (defined $path) {
			if (killall(0, $path)) {
				$ret = 1;
			}
		} else {
			my $pid = get_pid("$FULL_SERVICE.pid");
			if (defined $pid) {
				$ret = kill 0, $pid;
			}
		}
	}
	return $ret;
}
if ($COMMAND eq 'is-active' or $COMMAND eq 'status') {
	if (is_running($data)) {
		print "active\n";
		exit;
	}
	print "inactive\n";
	exit 3;
}

sub exec_stop_pre {
	my ($data) = @_;
	if (defined $data->{'Socket.ExecStopPre'}) {
		for my $x (@{ $data->{'Socket.ExecStopPre'} }) {
			log_command("Running stop pre [$x]\n");
			system $x;
		}
	}
}
sub exec_stop_post {
	my ($data) = @_;
	if (defined $data->{'Service.ExecStopPost'}) {
		for my $x (@{ $data->{'Service.ExecStopPost'} }) {
			log_command("Running stop post [$x]\n");
			system $x;
		}
	}
}

if ($TYPE eq 'target' and not defined $data->{'Unit.Wanted'}) {
	warn "No Unit.Wanted/.wants list for target [$SERVICE]\n";
	exit 8;
}

if ($COMMAND eq 'restart') {
	if ($TYPE eq 'target') {
		for my $x (@{ $data->{'Unit.Wanted'} }) {
			system $0, 'stop', $x;
		}
		for my $x (reverse @{ $data->{'Unit.Wanted'} }) {
			system $0, 'start', $x;
		}
	} else {
		system $0, 'stop', $FULL_SERVICE;
		system $0, 'start', $FULL_SERVICE;
	}
	exit;
}

sub stop_pids {
	my @pids = @_;
	kill -15, @pids;
	sleep 1;
	if (kill 0, @pids) {
		kill -9, @pids;
		sleep 3;
		if (kill 0, @pids) {
			log_command("Failed to kill [@pids] even with 9\n");
			warn "Failed to kill [@pids].\n";
			return 1;
		}
		log_command("Killed [@pids] with 9\n");
	} else {
		log_command("Killed [@pids] with 15\n");
	}
	return 0;
}

if ($COMMAND eq 'stop') {
	my $mainpid;
	if (defined $data->{'Service.PIDFile'}) {
		$mainpid = get_pid($data->{'Service.PIDFile'});
	} else {
		$mainpid = get_pid("$FULL_SERVICE.pid");
	}
	if (defined $data->{'Service.ExecStop'}) {
		for my $x (@{ $data->{'Service.ExecStop'} }) {
			my $runit = 1;
			if (defined $mainpid) {
				$x =~ s!\$MAINPID\b|\$\{MAINPID\}!$mainpid!g;
			} elsif ($x =~ /\$MAINPID\b|\$\{MAINPID\}/) {
				$runit = 0;
				log_command("Service [$FULL_SERVICE] would like to stop via ExecStop [$x] but we have no pid file, skipping.\n");
			}
			if ($runit) {
				log_command("Running stop [$x]\n");
				system $x;
				sleep 3;
			}
		}
	}
	my $ret = 0;
	if ($TYPE eq 'target') {
		for my $x (@{ $data->{'Unit.Wanted'} }) {
			system $0, 'stop', $x;
		}
		$ret = 0;
	} elsif ($TYPE eq 'socket') {
		my $pids = `/usr/sbin/fuser $data->{'Socket.ListenStream'} 2> /dev/null`;
		if (defined $pids) {
			chomp $pids;
			$pids =~ s/^\s+//;
			my @pids = split /\s+/, $pids;
			if (@pids) {
				exec_stop_pre($data);
				$ret = stop_pids(@pids);
			}
		}
	} elsif (defined $data->{'Service.PIDFile'}) {
		my $pid = get_pid($data->{'Service.PIDFile'});
		if (defined $pid) {
			$ret = stop_pids($pid);
		}
	} else {
		my $path = get_pid("$FULL_SERVICE.name");
		if (defined $path) {
			if (killall(0, $path)) {
				sleep 1;
				if (killall(15, $path)) {
					sleep 3;
					if (killall(9, $path)) {
						sleep 1;
						if (killall(0, $path)) {
							warn "Failed to kill [$FULL_SERVICE] via killall [$path].\n";
							$ret = 1;
						}
					}
				}
			}
		} else {
			my $pid = get_pid("$FULL_SERVICE.pid");
			if (defined $pid) {
				$ret = stop_pids($pid);
			} else {
				warn "No pid and no name for [$FULL_SERVICE].\n";
			}
		}
	}
	exec_stop_post($data);
	unlink "$RUNNING_DIR/$FULL_SERVICE.pid", "$RUNNING_DIR/$FULL_SERVICE.name", "$RUNNING_DIR/$FULL_SERVICE.oneshot";
	exit $ret;
}

sub add_runuser {
	my ($data, $cmd) = @_;
	if (defined $data->{'Service.User'}) {
		unshift @$cmd, '-u', $data->{'Service.User'}, '--';
		if (defined $data->{'Service.Group'}) {
			unshift @$cmd, '-g', $data->{'Service.Group'};
		}
		unshift @$cmd, '/usr/sbin/runuser-pp';
	}
}

if ($COMMAND eq 'start') {
	if ($TYPE eq 'service' and is_running($data)) {
		log_command("Service [$FULL_SERVICE] already found running, not starting again.\n");
		exit;
	}
	if ($TYPE eq 'socket' and -S $data->{'Socket.ListenStream'}) {
		my $out = `/usr/sbin/fuser $data->{'Socket.ListenStream'} 2> /dev/null`;
		if (defined $out and $out ne '') {
			log_command("Service [$FULL_SERVICE] already found active on socket [$data->{'Socket.ListenStream'}], not starting again.\n");
			exit;
		}
	}
	if (defined $data->{'Service.Type'} and $data->{'Service.Type'} eq 'dbus') {
		my @cmd = ($0, 'start', 'dbus.socket');
		log_command("Running [@cmd]\n");
		system @cmd;
	}
	if (defined $data->{'Service.ExecStartPre'}) {
		for my $x (@{ $data->{'Service.ExecStartPre'} }) {
			my $can_fail = 0;
			if ($x =~ s/^-//) {
				$can_fail = 1;
			}
			my @cmd = split /\s+/, $x;
			if (not $data->{'Service.PermissionsStartOnly'} or $data->{'Service.PermissionsStartOnly'} =~ /^(false|0)$/i) {
				add_runuser($data, \@cmd);
			}
			no warnings 'uninitialized';
			log_command("Running start pre [@cmd]\n");
			if (system @cmd and not $can_fail) {
				exit 1;
			}
		}
	}
	my @paths;
	if ($TYPE eq 'target') {
		for my $x (@{ $data->{'Unit.Wanted'} }) {
			my @cmd = ($0, 'start', $x);
			log_command("Running [@cmd]\n");
			system @cmd;
		}
		exit;
	} elsif ($TYPE eq 'socket') {
		my $service = $SERVICE;
		if (defined $data->{'Socket.Accept'} and $data->{'Socket.Accept'} eq 'true') {
			$service =~ s/\.socket$/\@.service/;
			@paths = ( '/bin/systemctl-socket-daemon', $data->{'Socket.ListenStream'}, $data->{'Socket.SocketMode'} // '0666', $service );
		} else {
			$service =~ s/\.socket$/\.service/;
			my $ret = system "$0 is-active $service > /dev/null";
			if (($ret >> 8) == 0) {
				log_command("Service [$service] is already running for [$SERVICE]\n");
				exit;
			}
			@paths = ( $0, 'start', $service );
		}
	} else {
		@paths = get_exec_start($data);
	}
	my $first_path = $paths[0];

	my $ENV = '';
	if (exists $data->{'Service.EnvironmentFile'}) {
		for my $e (@{ $data->{'Service.EnvironmentFile'} }) {
			my $error_fail = 1;
			if ($e =~ s/^-//) {
				$error_fail = 0;
			}
			my $fh = new IO::File($e);
			if (not defined $fh) {
				if ($error_fail) {
					warn "Error reading EnvironmentFile [$e]: $!\n";
					exit 5;
				}
			} else {
				while (my $line = <$fh>) {
					chomp $line;
					next if $line =~ /^\s*(#|$)/;
					$ENV .= "export $line; ";
				}
				$fh->close();
			}
		}
	}
	if (defined $data->{'Service.Environment'}) {
		my $x = $data->{'Service.Environment'};
		$x =~ s/^"(.*)"$/$1/;
		$ENV .= "export $x; ";
	}
	add_runuser($data, \@paths);
	log_command("Running [$ENV@paths]\n");
	if (defined $data->{'Service.Type'} and $data->{'Service.Type'} eq 'oneshot') {
		system "$ENV@paths";
		if (defined $data->{'Service.RemainAfterExit'} and $data->{'Service.RemainAfterExit'} eq 'yes') {
			local * PIDFILE;
			open PIDFILE, '>', "$RUNNING_DIR/$FULL_SERVICE.oneshot";
			close PIDFILE;
		}
		exit;
	}
	my $pid = fork();
	die "Failed to fork for [@_]\n" if not defined $pid;
	if ($pid == 0) {
		open(STDOUT, '>>', '/var/log/systemctl.log');
		open(STDERR, '>>', '/var/log/systemctl.log');
		open(STDIN, '<', '/dev/null');
		POSIX::setsid();
		exec "$ENV@paths";
	}
	local * PIDFILE;
	open PIDFILE, '>', "$RUNNING_DIR/$FULL_SERVICE.pid";
	print PIDFILE "$pid\n";
	close PIDFILE;
	log_command("Marked pid [$pid]\n");
	sleep 1;
	if (killall(0, $first_path)) {
		local * PIDFILE;
		open PIDFILE, '>', "$RUNNING_DIR/$FULL_SERVICE.name";
		print PIDFILE "$first_path\n";
		close PIDFILE;
		log_command("Marked process name [$first_path]\n");
	}
	if (defined $data->{'Service.Type'}
		and $data->{'Service.Type'} eq 'dbus'
		and defined $data->{'Service.BusName'}) {
		my $busname = $data->{'Service.BusName'};
		my $objectpath = $busname;
		$objectpath =~ s!^|\.!/!g;
		for (0 .. 10) {
			system "/usr/bin/dbus-send --system --type=method_call --print-reply --dest=$busname $objectpath org.freedesktop.DBus.Introspectable.Introspect > /dev/null";
			last if ($? >> 8) == 0;
			sleep 1;
		}
	}
	exit;
}

if ($COMMAND eq 'is-enabled') {
	if (-e "$ENABLED_DIR/$FULL_SERVICE") {
		print "enabled\n";
		exit 0;
	}
	print "disabled\n";
	exit 1;
}

if ($COMMAND eq 'enable') {
	if (not -d $ENABLED_DIR) {
		mkdir $ENABLED_DIR;
	}
	local * FILE;
	open FILE, '>', "$ENABLED_DIR/$FULL_SERVICE";
	exit;
}

if ($COMMAND eq 'disable') {
	unlink "$ENABLED_DIR/$FULL_SERVICE";
	exit;
}

die "Unknown command [$COMMAND].\n";

1;

